home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / MENUDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-09  |  2KB  |  87 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Tips & Techniques Demo Program               }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program MenuDemo;
  10.  
  11. {$R T&TMenu}
  12.  
  13. uses WinTypes, WinProcs, WObjects;
  14.  
  15. const
  16.   cm_Toggle  =  100;
  17.   cm_Hello   =  101;
  18.   cm_GoodBye =  102;
  19.   MenuAdded: Boolean = false;
  20.  
  21. type
  22.   PMyapp = ^TMyApp;
  23.   TMyApp = object(TApplication)
  24.     procedure InitMainWindow; virtual;
  25.   end;
  26.  
  27.   PMyWindow = ^TMyWindow;
  28.   TMyWindow = object(TWindow)
  29.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  30.     procedure Hello(var Message: TMessage);
  31.       virtual cm_First + cm_Hello;
  32.     procedure GoodBye(var Message: TMessage);
  33.       virtual cm_First + cm_GoodBye;
  34.     procedure Toggle(var Message: TMessage);
  35.       virtual cm_First + cm_Toggle;
  36.   end;
  37.  
  38. procedure TMyWindow.Toggle(var Message: TMessage);
  39. begin
  40.   if not MenuAdded then
  41.     AppendMenu(GetSubMenu(Attr.Menu, 0), mf_Enabled, 102, '&GoodBye')
  42.   else
  43.     DeleteMenu(GetSubMenu(Attr.Menu, 0), 102, mf_ByCommand);
  44.   if MenuAdded = True then
  45.     MenuAdded := False
  46.   else
  47.     MenuAdded := True;
  48. end;
  49.  
  50. procedure TMyWindow.Hello(var Message: TMessage);
  51. begin
  52.   MessageBox(HWindow, 'Hello everyone!', 'Incoming Memo',
  53.     mb_IconInformation);
  54. end;
  55.  
  56. procedure TMyWindow.GoodBye(var Message: TMessage);
  57. begin
  58.   MessageBox(HWindow, 'Goodbye now!', 'Incoming Memo', mb_IconInformation);
  59. end;
  60.  
  61. constructor TMyWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  62. var
  63.   GreetingMenu, PopUp: HMenu;
  64. begin
  65.   TWindow.Init(AParent, ATitle);
  66.   GreetingMenu := CreateMenu;
  67.   Attr.Menu := GreetingMenu;
  68.   PopUp := CreatePopupMenu;
  69.   AppendMenu(GreetingMenu, mf_PopUp, PopUp, '&Greetings');
  70.   AppendMenu(PopUp, mf_BitMap or mf_Enabled, cm_Toggle,
  71.     PChar(LoadBitMap(HInstance, 'MenuBitMap')));
  72.   AppendMenu(PopUp, mf_Enabled, cm_Hello, '&Hello');
  73. end;
  74.  
  75. procedure TMyApp.InitMainWindow;
  76. begin
  77.   MainWindow := New(PMyWindow, Init(Nil, 'Menu Demo'));
  78. end;
  79.  
  80. var
  81.   MyApp: TMyApp;
  82.  
  83. begin
  84.   MyApp.Init('My Program');
  85.   MyApp.Run;
  86.   MyApp.Done;
  87. end.